Criterios

Definición de criterios de mantenimiento:

  1. Que no exista data al menos de 1 mes del sensor en la base de datos o el SI.
  2. Que la batería se encuentre bajo el 10%
  3. Que exista muy baja conectividad o tasa de transmisión
  4. Que el sensor, es su espectro, muestre un comportamiento defectuoso
mantenimiento <- factor(c("sin datos 1 mes", "baja conectividad", 
                          "bateria < 10%", "sensor defectuoso"))

Load data

Cargar la data importada via mongodb del mes completo de Octubre. Se carga lista de direcciones MAC asociadas a los sensores en csv

load("Data/dataOctubre.Rda")

# Read key, measurements, date and idler 
df <- data.frame(key = substr(data[,2],7,27) , NUM = 0, data[,3][,-1], 
                 date  = data[,4], idler = data[,5])

MAC <- read.csv("Data/dmiMAC2020.csv")[1:1200,c(1,2)]

Preprocessing data

Preparación de la data:

# Asignar valor etiqueta por key
for (i in 1:length(MAC$key)) {
  index <- which(as.character(df$key)==as.character(MAC$key[i]))
  df[index,"NUM"] <- as.numeric(substr(MAC$numDMI[i],3,6))
} 

# Casos con al menos un NA como variable y su promedio 
(sum(!complete.cases(df[4:67]))*100)/dim(df[4:67])[1]
## [1] 6.044449
# Dataframe de datos completos
complete <- data.frame(NUM = as.numeric(substr(MAC$numDMI,3,6)), 
                       NAS = 0, DAT = 0)

#Casos con NAs
TNas <- table(df[!complete.cases(df[4:67]),2])
for (j in 1:length(TNas)) {
  dmi <- as.numeric(names(TNas[j]))
  complete$NAS[dmi] <- TNas[[j]]
} 

#Casos completos
CNas <- table(df[complete.cases(df[4:67]),2])
for (j in 1:length(CNas)) {
  dmi <- as.numeric(names(CNas[j]))
  complete$DAT[dmi] <- CNas[[j]]
}

Criterio 1: Sin datos

Se regenera dataframe con primer criterio, obteniendo los sensores que en 1 mes completo no se ha ningún dato

# Cantidad de Sensores con al menos 1 dato (completo o incompleto) en Octubre
length(CNas)
## [1] 568
# Reporte por criterio 1: sin datos en 1 mes
setdiff(substr(MAC$numDMI,3,6), str_pad(names(CNas), 4, pad = "0"))
##   [1] "0002" "0003" "0007" "0008" "0009" "0010" "0011" "0012" "0013" "0014"
##  [11] "0018" "0020" "0023" "0024" "0027" "0030" "0031" "0036" "0039" "0040"
##  [21] "0041" "0042" "0043" "0045" "0047" "0050" "0051" "0053" "0054" "0057"
##  [31] "0058" "0062" "0064" "0067" "0070" "0072" "0073" "0079" "0080" "0081"
##  [41] "0084" "0087" "0088" "0089" "0090" "0093" "0094" "0097" "0098" "0100"
##  [51] "0101" "0104" "0106" "0110" "0113" "0114" "0117" "0118" "0121" "0122"
##  [61] "0123" "0127" "0130" "0134" "0135" "0136" "0139" "0141" "0144" "0145"
##  [71] "0149" "0150" "0151" "0152" "0154" "0155" "0156" "0157" "0161" "0162"
##  [81] "0165" "0168" "0171" "0172" "0179" "0180" "0182" "0183" "0186" "0188"
##  [91] "0191" "0192" "0193" "0196" "0197" "0198" "0204" "0205" "0206" "0211"
## [101] "0215" "0216" "0217" "0218" "0219" "0222" "0223" "0225" "0227" "0228"
## [111] "0230" "0231" "0233" "0234" "0236" "0237" "0239" "0240" "0242" "0246"
## [121] "0247" "0248" "0249" "0250" "0254" "0258" "0259" "0261" "0262" "0263"
## [131] "0267" "0268" "0269" "0272" "0276" "0278" "0279" "0280" "0282" "0284"
## [141] "0286" "0287" "0289" "0292" "0295" "0297" "0298" "0301" "0304" "0305"
## [151] "0307" "0308" "0309" "0310" "0314" "0315" "0316" "0317" "0318" "0324"
## [161] "0325" "0326" "0332" "0335" "0337" "0340" "0342" "0344" "0349" "0350"
## [171] "0351" "0352" "0356" "0357" "0361" "0364" "0365" "0366" "0371" "0372"
## [181] "0373" "0376" "0381" "0383" "0385" "0387" "0389" "0391" "0393" "0394"
## [191] "0395" "0398" "0399" "0400" "0407" "0409" "0410" "0411" "0413" "0414"
## [201] "0415" "0416" "0417" "0419" "0424" "0425" "0426" "0428" "0430" "0431"
## [211] "0433" "0437" "0442" "0444" "0446" "0447" "0448" "0450" "0451" "0453"
## [221] "0456" "0457" "0461" "0462" "0463" "0466" "0468" "0470" "0471" "0472"
## [231] "0473" "0474" "0475" "0477" "0478" "0480" "0482" "0485" "0487" "0495"
## [241] "0496" "0497" "0498" "0500" "0501" "0503" "0504" "0505" "0507" "0508"
## [251] "0509" "0510" "0518" "0519" "0521" "0524" "0527" "0528" "0529" "0530"
## [261] "0531" "0538" "0540" "0542" "0543" "0544" "0546" "0550" "0553" "0554"
## [271] "0555" "0556" "0557" "0558" "0560" "0562" "0563" "0566" "0568" "0569"
## [281] "0576" "0581" "0587" "0588" "0589" "0590" "0591" "0592" "0593" "0594"
## [291] "0595" "0598" "0600" "0601" "0603" "0605" "0607" "0608" "0609" "0612"
## [301] "0614" "0617" "0618" "0619" "0620" "0622" "0623" "0625" "0626" "0627"
## [311] "0631" "0632" "0634" "0638" "0639" "0640" "0641" "0643" "0646" "0647"
## [321] "0648" "0649" "0652" "0653" "0655" "0656" "0658" "0659" "0660" "0662"
## [331] "0663" "0664" "0665" "0666" "0667" "0670" "0672" "0673" "0677" "0679"
## [341] "0680" "0681" "0683" "0685" "0686" "0687" "0690" "0691" "0693" "0698"
## [351] "0701" "0702" "0703" "0705" "0707" "0708" "0709" "0711" "0712" "0713"
## [361] "0717" "0718" "0719" "0722" "0724" "0727" "0729" "0730" "0732" "0736"
## [371] "0739" "0740" "0742" "0743" "0744" "0745" "0748" "0752" "0753" "0756"
## [381] "0757" "0762" "0764" "0765" "0766" "0767" "0768" "0769" "0770" "0772"
## [391] "0773" "0774" "0776" "0777" "0778" "0779" "0780" "0781" "0782" "0784"
## [401] "0785" "0786" "0787" "0788" "0790" "0791" "0794" "0795" "0796" "0797"
## [411] "0798" "0799" "0800" "0804" "0806" "0807" "0809" "0810" "0811" "0812"
## [421] "0815" "0817" "0819" "0822" "0826" "0827" "0829" "0830" "0831" "0832"
## [431] "0834" "0835" "0836" "0837" "0838" "0839" "0841" "0842" "0843" "0845"
## [441] "0846" "0848" "0849" "0850" "0851" "0852" "0855" "0856" "0857" "0860"
## [451] "0861" "0862" "0865" "0867" "0869" "0870" "0871" "0872" "0873" "0874"
## [461] "0876" "0879" "0880" "0882" "0883" "0885" "0887" "0890" "0892" "0893"
## [471] "0894" "0896" "0900" "0903" "0904" "0905" "0907" "0909" "0912" "0914"
## [481] "0915" "0917" "0919" "0920" "0921" "0922" "0923" "0926" "0927" "0928"
## [491] "0930" "0931" "0932" "0936" "0938" "0941" "0943" "0944" "0946" "0947"
## [501] "0948" "0949" "0950" "0952" "0953" "0960" "0962" "0963" "0964" "0967"
## [511] "0969" "0971" "0973" "0974" "0977" "0979" "0980" "0981" "0982" "0983"
## [521] "0984" "0988" "0991" "0993" "0994" "0995" "0997" "0998" "0999" "1000"
## [531] "1001" "1004" "1006" "1007" "1010" "1013" "1015" "1018" "1020" "1022"
## [541] "1024" "1027" "1031" "1032" "1033" "1038" "1039" "1041" "1045" "1048"
## [551] "1049" "1050" "1051" "1056" "1057" "1058" "1060" "1061" "1064" "1065"
## [561] "1067" "1069" "1070" "1071" "1076" "1077" "1078" "1081" "1082" "1083"
## [571] "1085" "1086" "1087" "1090" "1092" "1096" "1097" "1100" "1101" "1105"
## [581] "1108" "1111" "1113" "1114" "1115" "1117" "1120" "1121" "1122" "1123"
## [591] "1126" "1128" "1129" "1132" "1135" "1139" "1142" "1144" "1145" "1149"
## [601] "1150" "1151" "1152" "1153" "1154" "1159" "1160" "1161" "1162" "1163"
## [611] "1165" "1166" "1168" "1169" "1170" "1171" "1173" "1174" "1176" "1177"
## [621] "1178" "1181" "1185" "1186" "1188" "1190" "1194" "1195" "1197" "1198"
## [631] "1199" "1200"
REPORTE <- MAC[-as.numeric(names(CNas)),]
REPORTE$Criterio <- mantenimiento[1]

Criterio 2: Baja transmisión

A partir del criterio dos se busca obtener datos con muy baja transmisión en un mes. Se obtiene grafico en ggplot para ver la transmisibilidad general de los sensores

# Casos totales 
complete$TOTAL <- complete$NAS + complete$DAT
# Filtrar casos con mediciones
complete <- filter(complete, TOTAL > 0)

complete.long <- melt(complete, id = "NUM", measure = c("NAS", "TOTAL"))
g <- ggplot(complete.long, aes(NUM, value, colour = variable)) 
g + geom_point(pch = 16, size = 1.5, alpha=0.4)  + geom_line() +
  labs(title="Octubre SMAP Sulfuro", y="Frecuencia", x="Número Sensor AA-") +
  theme(plot.title = element_text(hjust = 0.5)) +
  coord_cartesian(xlim = c(0,1200)) + geom_smooth(method = "lm", se = FALSE)
## `geom_smooth()` using formula 'y ~ x'

Se obtiene un valor promerio de aprox 250 mediciones/mes. Lo cual equivale a

\(250 \frac{mediciones}{mes} = 8.33\frac{mediciones}{día} = 2.88\frac{horas}{medicion}\)

Se considerará para mantenimiento que la tasa de transmisión sea menor a 10 transmisiones/mes

Se obtiene que la menor tasa de transmisiones la obtienen los siguientes sensores

complete[complete$TOTAL<10,]
##      NUM NAS DAT TOTAL
## 46    87   1   0     1
## 104  196   3   0     3
## 139  267   2   0     2
## 140  270   0   5     5
## 172  331   0   3     3
## 189  360   0   1     1
## 205  387   2   0     2
## 219  417   2   0     2
## 244  463   3   0     3
## 255  488   0   6     6
## 265  508   1   0     1
## 287  546   7   0     7
## 314  590   2   0     2
## 352  686   1   0     1
## 370  723   0   6     6
## 417  847   0   3     3
## 467  965   0   7     7
## 482 1001   1   0     1
## 487 1009   0   4     4
## 523 1075   0   6     6
## 529 1091   0   1     1
## 548 1126   2   0     2
REPORTE2 <- MAC[complete[complete$TOTAL<10,1],]
REPORTE2$Criterio <- mantenimiento[2]

Criterio 3: Baja batería

Se agrupan los sensores por su numero y se obtiene el promedio de las bateria. Se considerará para mantenimiento los sensores con batería menor al 10% y valores NA

df %>% group_by(NUM) %>% 
  summarise(avg = mean(batt_percentage, na.rm = TRUE)) %>% {. ->> b }
## `summarise()` ungrouping output (override with `.groups` argument)
ggplot(b, aes(NUM, avg)) + geom_point(alpha = 0.6, col = ifelse(b$avg < 10,'red','green')) + 
  geom_smooth(method = "lm") + theme(plot.title = element_text(hjust = 0.5)) +
  labs(title="Batería Octubre SMAP Sulfuro", y="Bateria %", x="Número Sensor AA-") 
## `geom_smooth()` using formula 'y ~ x'

b[b$avg<10 | is.na(b$avg),]
## # A tibble: 100 x 2
##      NUM     avg
##    <dbl>   <dbl>
##  1    15   6.19 
##  2    21   0    
##  3    28   2.47 
##  4    44   9.11 
##  5    48   0.321
##  6    49   0    
##  7    69   5.28 
##  8    82   4.75 
##  9    87 NaN    
## 10    91   0    
## # ... with 90 more rows
REPORTE3 <- MAC[as.matrix(b[b$avg<10 | is.na(b$avg),1]),]
REPORTE3$Criterio <- mantenimiento[3]

Criterio 4: Sensor defectuoso

df2 <- aggregate(df[, 4:67], list(df$NUM), mean, na.rm = T)
df2 <- df2[complete.cases(df2),]

long <- melt(df2, id = "Group.1", measure = c(2:65))
g <- ggplot(long, aes(variable, value, colour = Group.1)) 
g  + geom_line(aes(group = Group.1), alpha = 0.3, size = 1) +
  labs(title="Promedio espectral por sensor, Octubre SMAP Sulfuro", y="Frecuencia", x="Número Sensor AA-XXXX", colour = "DMI") + theme(plot.title = element_text(hjust = 0.5), axis.text.x = element_text(angle=90, hjust=1, vjust = 1, size=5)) + scale_color_gradient(low = "blue", high = "lightblue")

Se observa sólo 1 sensor con valores fijos. Para hacer aún más grafico e interactivo, se utiliza libreria plotly para rehacer el gráfico y visualizar los datos.

fig <- plot_ly(x=long$variable, y=long$value, 
               name = long$Group.1, type = 'scatter', mode = 'lines', line = list(width = 1))
fig

Como se observa en la figura, es el sensor 966 que se encuentra fijo en un valor alto, por lo cual se deduce que se encuentra malo.

REPORTE4 <- MAC[966,]
REPORTE4$Criterio <- mantenimiento[4]

Resumen

Luego, el total de sensores para realizar mantenimiento está dado por estas cuatro condiciones. Se genera reporte en xlsx

REPORT <- bind_rows(REPORTE, REPORTE2, REPORTE3, REPORTE4)
# Total sensores mantenimiento
dim(REPORT)[1]
## [1] 755
# Porcentaje de disponibilidad actual
paste(sprintf("%.1f", (1 - dim(REPORT)[1]/1200)*100), "%")
## [1] "37.1 %"
# Generar reporte csv
readr::write_excel_csv(REPORT, file = "Reporte.csv" )

REPORTE DISPONIBLE AQUI